perm filename MOVR.F4[NEW,LCS] blob sn#148537 filedate 1975-03-04 generic text, type T, neo UTF8
00100		SUBROUTINE MOVR(ML,J2,JJ2,JY,L,INP,RN,PWDS,R4,ITEM,I)
00200		DIMENSION RN(1),PWDS(1),R4(1)
00300	C  R4(2)→R5, R4(3)→R6, R4(4)→R7, R4(5)→R8, R4(6)→R9, R4(8)→R11
21800	6551	RB=RN(JY)
21900		J2=J2+1
22000		IF(RTLINE(JY))GO TO 7551
22100	C  IF STAFF#>4, ALL STAVES ARE MOVED.
22200		RA=RN(JY+1)
22300		IF(R4(3).LE.0)GO TO 577
22310		IF(R4(3).NE.RA)GO TO 7551
22400	C SKIPS IF NOT SPECIAL CODE NUM.
22500	577	RN3=RN(JY+3)
22600		IF(RN3.GT.R4(2))GO TO 7551
22700		RC=-1
22800		RD=0
22900		IF(RA.LT.5)GO TO 677
22910		IF(RA.LE.7)RD=-1
23000	677	IF(RA.EQ.4.)GO TO 777
23010		IF(RD)GO TO 777
23020		IF(RN(JY+5).NE.50)GO TO 877
23030	777	RC=0
23100	C RC=0 FOR CODES 4,5,6
23200	877	RN6=RN(JY+6)
23300		IF(RN3.GE.R4(1))GO TO 8
23400	      IF(RC)GO TO 7551
23410		IF(RC.NE.0)GO TO 8
23420		IF(RN6.LE.R4(1))GO TO 7551
23430		IF(RN6.GE.R4(2))GO TO 7551
23500	C RIGHT SIDE IS BEFORE OR AFTER MOVE AREA.
23600	C  IF INP='C' MOVE TO NEW SPOT AND LEAVE OLD BEHIND.
23700	8	IF(ASK)GO TO 100
23800		CALL ASKIT
23900		IF(K.EQ.'N')GO TO 7551
24000		IF(K.EQ.'X')GO TO 1
24100	C  'X'=EXIT
24200	C  N=NO, <CR>=YES
24300	100	IF(INP.NE.'C')GO TO 9551
24400		K=RB+2
24500		CALL LOOP(0,K,1,L,JY,RN)
24600		ITEM=ITEM+1
24700		IF(JJ2)JJ2=ITEM
24800	C  JJ2 SAVES ITEM # FOR MAIN PROG.
24900		PWDS(ITEM+1)=L+K+1
25000	9551	IF(JJ2)JJ2=J2
25100	C   (50=CRESC., DECRESC.)
25200		IF(R2.LT.5)GO TO 977
25205		IF(R2.NE.88.)GO TO 771
25210	977	RN(L+2)=R4(4)
25300	771	IF(RA.EQ.8)GO TO 7552
25350	C 8=STAFF. ONLY MOVES OR COPIES TO NEW STAFF NUM. OTHER PARAMS UNAFFECTED.
25400		RQ6=RN6-R4(2)
25500		RX=0
25510		RV=0
25600		IF(RA.NE.6)GO TO 21
25610		IF(RB.LT.7)GO TO 21
25700		RX=RN(L+9)
25800		RY=RX-R4(2)
25900		RZ=R4(1)-RX
25930		IF(RN(L+10).LT.30)GO TO 221
25940		RW=RN(L+8)
25950		IF(RW.LT.R4(1))GO TO 221
25960		IF(RW.LE.R4(2))RV=-1
26000	221	IF(RY.GE.0)GO TO 21
26010		IF(RZ)RX=-1
26100	C PARTIAL BEAM IS WITHIN MOVE AREA.
26200	21	IF(R4(6).EQ.0)GO TO 2551
26350		IF(RN3.GE.R4(1))CALL MVBX(3)
26375	C  MOVES P4 LFT-RT.   ↑↑↑↑↑↑↑↑
26400		IF(RC)GO TO 7552
26500		IF(RA.NE.4.)GO TO 772
26510		IF(RB.LT.4)GO TO 7552
26610	772	IF(RQ6)CALL MVBX(6)
26700	C  END POINT OUTSIDE OF MOVE RANGE NOT AFFECTED.
26800		IF(RA.NE.6)GO TO 7552
26900		IF(RX)CALL MVBX(9)
26910		IF(RV)CALL MVBX(8)
27000	C  ONLY TRUE WHEN RA=6
27100		GO TO 7552
27110	168	IF(J2.GT.R4(2))GO TO 101
27112	CC168	IF(J2.GT.LDGR)GO TO 101
27132		JY=PWDS(J2+1)
27154		IF(INP.NE.'C')L=JY
27176		GO TO 6551
27178	101	ML=3
27180		RETURN
27200	
27300	2551	IF(RN3.GE.R4(1))RN3=RN3+R4(5)
27400		RN(L+3)=RN3
27500	      IF(RQ6.GE.0)GO TO 773
27510		IF(RD)GO TO 774
27520		IF(RA.NE.4)GO TO 773
27530		IF(RB.LE.3.)GO TO 773
27540	774	RN(L+6)=RN(JY+6)+R4(5)
27600	773	IF(RX)CALL MVBEAM(RN,9,JY,L,R4(5))
27610		IF(RV)CALL MVBEAM(RN,8,JY,L,R4(5))
27700		IF(RN3.GT.ROV)ROV=RN3
27800	C ??? NOT YET FIXED FOR ENDS OF SLURS OR LINES
27900	7552	L=RB+3+L
28000		IF(R4(8).EQ.0)GO TO 7551
28160	1151	IF(RA.EQ.8)GO TO 7551
28170		IF(RA.EQ.18)GO TO 7551
28180		IF(RB.GE.3)GO TO 775
28190		IF(RA.EQ.9)GO TO 775
28195		IF(RA.NE.11)GO TO 7551
28200	C  'U-D' SKIPS METER, STAFF, KEY SIG., ETC. ???CHECK ABOVE↑↑↑↑↑↑↑↑
28300	775	JX=JY
28400		IF(INP.EQ.'C')JX=PWDS(ITEM)
28550		CALL MVBEAM(RN,4,JX,JX,R4(8))
28560		IF(RC.EQ.0)CALL MVBEAM(RN,5,JX,JX,R4(8))
28700	7551	JY=RB+3+JY
28800		IF(INP.NE.'C')L=JY
28850		IF(R2.EQ.88)GO TO 168
28900		IF(JY.LT.I)GO TO 6551
29200	1	CALL HYDPOG(3)
29300	5	FORMAT(' TYPE NEW STAFF #, POS1, POS2, UP-DOWN #  '$)
29400		END